home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / xphil.em < prev   
Lisp/Scheme  |  1992-10-06  |  3KB  |  101 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                           ;;
  3. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  4. ;;                                                                           ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defmodule xphil
  8.  
  9.   (lists
  10.    list-operators
  11.    extras
  12.    streams
  13.    arith
  14.    others
  15.  
  16.    linda-base
  17.    linda-tabs
  18.    linda
  19.    vectors
  20.    threads
  21.    semaphores
  22.  
  23.    driver) ()
  24.  
  25.   ;; Graphics...
  26.  
  27.   (plot-string X-stream 155 495 "Dining Philosophers in Linda")
  28.  
  29.   (read-pixmap X-stream "phil.xbm") ;; Philosopher
  30.   (read-pixmap X-stream "thinks.xbm") ;; Idea
  31.   (read-pixmap X-stream "sticks.xbm") ;; Chops
  32.   (read-pixmap X-stream "ticket.xbm") 
  33.   (read-pixmap X-stream "bulb.xbm") 
  34.  
  35.   (deflocal *think-level* 360)
  36.   (deflocal *eat-level* 140)
  37.   (deflocal *margin* 50)
  38.   (deflocal *space* 80)
  39.  
  40.   ;; Our linda pool...
  41.  
  42.   (deflocal phil-pool (make-linda-pool))
  43.  
  44.   ;; Parameter...
  45.  
  46.   (deflocal Num 6)
  47.  
  48.   ;; Philosopher process...
  49.  
  50.   (defun phil (i)
  51.     (tilnil
  52.       (linda-in phil-pool (tuple 'room-ticket))
  53.       (unplot X-stream 1 (+ *margin* (* i *space*)) (- *think-level* 40))
  54.       (plot X-stream 4 (+ *margin* (* i *space*)) (- *think-level* 40))
  55.       (unplot X-stream 4 (+ *margin* (* i *space*)) (- *think-level* 40))
  56.       (plot X-stream 3 (+ *margin* (* i *space*)) (+ *eat-level* 40))
  57.       (move X-stream i (+ *margin* (* i *space*)) *eat-level*)
  58.       (linda-in phil-pool (tuple 'chopstick i))
  59.       (linda-in phil-pool (tuple 'chopstick (remainder (+ i 1) Num)))
  60.       (plot X-stream 2 (+ *margin* (* i *space*)) (- *eat-level* 40))
  61.       (linda-out phil-pool (tuple 'chopstick i))
  62.       (linda-out phil-pool (tuple 'chopstick (remainder (+ i 1) Num)))
  63.       (unplot X-stream 2 (+ *margin* (* i *space*)) (- *eat-level* 40))
  64.       (linda-out phil-pool (tuple 'room-ticket))
  65.       (unplot X-stream 3 (+ *margin* (* i *space*)) (+ *eat-level* 40))
  66.       (move X-stream i (+ *margin* (* i *space*)) *think-level*)
  67.       (plot X-stream 1 (+ *margin* (* i *space*)) (- *think-level* 40))
  68.       t))
  69.   
  70.   (defun init () (init-aux Num))
  71.  
  72.   (defun init-aux (n)
  73.     (if (= n 0) 
  74.       (progn
  75.     (prin "init complete for ") (prin Num) (print " philosophers")
  76. ;;    (linda-in phil-pool (tuple 'zombie))
  77.     (thread-suspend))
  78.       (progn
  79.     (linda-out phil-pool (tuple 'chopstick (- n 1)))
  80.     (manage X-stream 0)
  81.     (move X-stream (- Num n) (+ *margin* (* (- Num n) *space*))
  82.           *think-level*)
  83.     (plot X-stream 1 (+ *margin* (* (- Num n) *space*)) 
  84.           (- *think-level* 40))
  85. ;;    (plot X-stream 0 (+ *margin* (* (- Num n) *space*)) *think-level*)
  86.     (prin "phil ") (prin (- n 1))
  87.     (prin " is ") (print (linda-start phil (- Num n)))
  88.     (if (< (- n 1) (- Num 1)) 
  89.       (linda-out phil-pool (tuple 'room-ticket))
  90.       nil)
  91.     (init-aux (- n 1)))))
  92.  
  93.   (defun doit () (linda-start init) (linda-scheduler))
  94.  
  95.   (doit)
  96.  
  97. )
  98.     
  99.     
  100.     
  101.